home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-03 / qb4libm.zip / FASTQLB.BAS < prev    next >
BASIC Source File  |  1990-10-05  |  45KB  |  1,099 lines
  1. '╔═════╡ FASTQLB.BAS - .QLB maker utility (enhanced) for BASIC programs ╞════╗
  2. '║The original utility was named MAKEQLB and distributed by Crescent Software║
  3. '║    Enhancements by David A. Violette, 12 Michaud Ave, Lewiston ME 04240   ║
  4. '║    207+783-6171 (eves).   CompuServe 76456,1602               12 Aug 90   ║
  5. '║                                                                           ║
  6. '║ I have changed this program so that the file Objects.obj is named         ║
  7. '║ EXTERNAL.OBJ, and the file is retained instead of KILLed.  By including   ║
  8. '║ EXTERNAL.OBJ in the LINK response file, a separate .LIB is not needed,    ║
  9. '║ since the external objects are already referenced in EXTERNAL.OBJ, and    ║
  10. '║ the program can be compiled and linked from the command line using the    ║
  11. '║ response file.  This change allows easy and smallest .QLB but adds easy   ║
  12. '║ command line compilation/link using MAKE or NMAKE.  See SUB MakeObj as    ║
  13. '║ well as this main module.                                                 ║
  14. '║                                                                           ║
  15. '║ FASTQLB may be invoked from the command line in one of several options:   ║
  16. '║                                                                           ║
  17. '║ (1) FASTQLB prog.BAS,prog.QLB,prog.LST,PRO7 progUITB DTFMTER FINANCER,_   ║
  18. '║       QBXQLB;                                                             ║
  19. '║                                                                           ║
  20. '║ (2) FASTQLB prog.LST,prog.QLB,prog.LST,PRO7 progUITB DTFMTER FINANCER,_   ║
  21. '║       QBXQLB;                                                             ║
  22. '║                                                                           ║
  23. '║ (3) FASTQLB @response.ext                                                 ║
  24. '║                                                                           ║
  25. '║    prog is the name of the program.  PRO7 is Crescent Software's QuickPak ║
  26. '║    Professional library for BC7; this is searched for routines I might    ║
  27. '║    use in prog.                                                           ║
  28. '║                                                                           ║
  29. '║    DTFTMTER and FINANCER are libraries supplied by Microsoft with BC7 -   ║
  30. '║    these are searched when I use routines from them.                      ║
  31. '║                                                                           ║
  32. '║    progUITB started as the UITBEFR library supplied by Microsoft with     ║
  33. '║    BC7, but I have modified several of the routines for use in prog and   ║
  34. '║    built this special library.                                            ║
  35. '║                                                                           ║
  36. '║    QBXQLB is the link library supplied by Microsoft with BC7.  Change     ║
  37. '║    this to match the compiler you are using (eg: BQLB45.LIB).             ║
  38. '║                                                                           ║
  39. '║ The first option will scan the source file given as the first parameter,  ║
  40. '║ plus any other module names listed in a prog.MAK file if present, to find ║
  41. '║ the required routines.                                                    ║
  42. '║                                                                           ║
  43. '║ The second option will get the names of the routines by reading a         ║
  44. '║ prog.LST file.  MAKEQLB (and FASTQLB) will create the prog.LST file when  ║
  45. '║ the first option is used, but you may manually edit this file to add or   ║
  46. '║ delete names of routines directly.  Using prog.LST will greatly speed up  ║
  47. '║ processing the QLB since MAKEQLB (and FASTQLB) won't have to scan all     ║
  48. '║ the source files.                                                         ║
  49. '║                                                                           ║
  50. '║ The third option allows use of a response file to shorten the command     ║
  51. '║ line.  The response file name is given immediately after the "@", and the ║
  52. '║ response file contains the items required on the command line, given in   ║
  53. '║ the same way they would on a command line.  The five parameters are       ║
  54. '║ described in Crescent's intro below (copied from their MAKEQLB.BAS        ║
  55. '║ module).  I use two versions of the response file - one with prog.BAS as  ║
  56. '║ the source file name, and one with prog.LST as the source file name.  The ║
  57. '║ first will act as option (1), the second as (2).                          ║
  58. '║                                                                           ║
  59. '║ An example response file for option (1) operation might be as follows:    ║
  60. '║                                                                           ║
  61. '║    prog.BAS,prog.QLB,prog.LST,PRO7 progUITB DTFMTER FINANCER,+            ║
  62. '║    QBXQLB;                                                                ║
  63. '║                                                                           ║
  64. '║ An example response file for option (2) operation might be as follows:    ║
  65. '║                                                                           ║
  66. '║    prog.LST,prog.QLB,prog.LST,PRO7 progUITB DTFMTER FINANCER,QBXQLB;      ║
  67. '║                                                                           ║
  68. '║ The response file must have the parameters separated by commas and spaces ║
  69. '║ as shown.  If MAKEQLB (and FASTQLB) find a "+" it is replaced with a " "  ║
  70. '║ and the next line is appended.  Essentially, the response file replaces   ║
  71. '║ command line parameters and allows longer lines to be edited using the +  ║
  72. '║ as a continuation symbol.                                                 ║
  73. '║                                                                           ║
  74. '║ A major advantage in using FASTQLB instead of MAKEQLB is that the file    ║
  75. '║ EXTERNAL.OBJ is saved for use in LINKing.  This avoids having to build a  ║
  76. '║ separate prog.LIB library as well as the prog.QLB, because EXTERNAL.OBJ   ║
  77. '║ can be used to identify the external routines to be pulled from other     ║
  78. '║ libraries.  This option is only available when you compile and link from  ║
  79. '║ the command line, however.                                                ║
  80. '║                                                                           ║
  81. '║ To use EXTERNAL.OBJ, simply include it in your list of object files to    ║
  82. '║ LINK.  I prefer to use a LINK response file, and I also use the MAKE      ║
  83. '║ utility with a companion description file.  The MAKE prog.DES file might  ║
  84. '║ look like this:                                                           ║
  85. '║                                                                           ║
  86. '║    prog.obj: prog.bas                                                     ║
  87. '║    bc prog /d/o/w/ah/fs;                                                  ║
  88. '║                                                                           ║
  89. '║    progmod1.obj: progmod1.bas                                             ║
  90. '║    bc progmod1 /d/o/w/ah/fs;                                              ║
  91. '║                                                                           ║
  92. '║    progmod2.obj: progmod2.bas                                             ║
  93. '║    bc progmod2 /d/o/w/ah/fs;                                              ║
  94. '║                                                                           ║
  95. '║    progmod3.obj: progmod3.bas                                             ║
  96. '║    bc progmod3 /d/o/w/ah/fs;                                              ║
  97. '║                                                                           ║
  98. '║    progmod4.obj: progmod4.bas                                             ║
  99. '║    bc progmod4 /d/o/w/ah/fs;                                              ║
  100. '║                                                                           ║
  101. '║    prog.exe: prog.obj progmod1.obj progmod2.obj progmod3.obj progmod4.obj ║
  102. '║    link @prog.rsp                                                         ║
  103. '║                                                                           ║
  104. '║ The link response file prog.rsp might look like this:                     ║
  105. '║                                                                           ║
  106. '║    prog progmod1 + progmod2 + (progmod3) + (progmod4) + EXTERNAL.OBJ      ║
  107. '║    prog                                                                   ║
  108. '║    prog                                                                   ║
  109. '║    PRO7.LIB + progUITB.LIB + DTFMTER.LIB + FINANCER.LIB                   ║
  110. '║                                                                           ║
  111. '║ I have also added a feature that writes the unreferenced items to a file  ║
  112. '║ for each module, where the filename is modulename.UNR.  This aids in      ║
  113. '║ cleaning up the modules.  See SUB ReadSource.                             ║
  114. '║                                                                           ║
  115. '║ I have added a variable LibDir$ which uses any LIB environment variable   ║
  116. '║ to find the necessary libraries.  See main module.                        ║
  117. '║                                                                           ║
  118. '╚═══════════════════════════════════════════════════════════════════════════╝
  119. '┌─────────┤ MAKEQLB.BAS - .QLB maker utility for BASIC programs ├───────────┐
  120. '│                                                                           │
  121. '│Copyright (c) 1988, 1989 Crescent Software                                 │
  122. '│by Don Malin and Chris May with user input enhancements by Ken White       │
  123. '│Notes:                                                                     │
  124. '│      Source files must be saved in Text format.                           │
  125. '│                                                                           │
  126. '│      Five parameters are required for this program -- one or more main    │
  127. '│      program names, the new .QLB file name, a list file name (NUL for no  │
  128. '│      list), one or more library names from which to extract the needed    │
  129. '│      routines, and the BQLB## support library.  As with LIB and LINK, a   │
  130. '│      semicolon (;) can be used to force MAKEQLB to use its defaults.      │
  131. '│                                                                           │
  132. '│      The program will check for routines that were declared but never     │
  133. '│      used or BASIC procedures that were defined but never used.           │
  134. '│      Declared unreferenced routines will not be added to the new Quick    │
  135. '│      Library.                                                             │
  136. '│                                                                           │
  137. '│      If a list file (.LST) is given in place of the source file name,     │
  138. '│      the program will make the quick library from the list instead of     │
  139. '│      searching the source files for external references.                  │
  140. '│                                                                           │
  141. '│MAKEQLB basicprogram1 [Basicprogram2], quicklib[.qlb], listfile[.lst],_    │
  142. '│        library[.lib] [library2[.lib], [bqlb##][;]                         │
  143. '│                                                                           │
  144. '│Compile and Link as follows:                                               │
  145. '│      BC makeqlb /ah /s [/fpa] /o;                                         │
  146. '│      LINK /e/noe makeqlb [nocom] [nolpt] [smallerr],,,pro;                │
  147. '│                                                                           │
  148. '│      [] = optional items. "/fpa" and "smallerr" are available with        │
  149. '│      BASCOM 6, "no" object files may be included with your compiler.      │
  150. '│                                                                           │
  151. '└───────────────────────────────────────────────────────────────────────────┘
  152.  
  153. DEFINT A-Z
  154.  
  155.  
  156. '~~~~~ Define Constants
  157. CONST BQLB$ = "QBXQLB.LIB"              'Default BASIC link library (BC 7)
  158. CONST BASProc = -1                      'Flag for BASIC procedures
  159. CONST RefedProc = -2                    'Flag for referenced procedures
  160. CONST MaxProcs = 300                    'Maximum number of procedures
  161. CONST ProcLen2 = 40                     'Maximum length for a procedure name
  162. CONST ProcLen = 30                      'Maximum length for module level
  163.                                         '  procedure names
  164.                                         '  Must be a power of 2 minus 2
  165.                                         '  [ie. 30 = (2 ^ 5) - 2]
  166.                                         '  because the TYPE below is used to
  167.                                         '  DIM a huge array whose size could
  168.                                         '  span multiple segments.
  169.  
  170. '~~~~~ Define TYPEs for procedure Info
  171. TYPE ModProcs                           'Module procedure information
  172.    ProcName AS STRING * ProcLen         'Procedure name
  173.    Count AS INTEGER                     'Number of references in module
  174. END TYPE
  175.  
  176. TYPE ProcInfo                           'Procedure information for program
  177.    ProcName AS STRING * ProcLen2        'Procedure name
  178.    AliasName AS STRING * ProcLen2       'ALIAS'ed name
  179.    BasFlag AS INTEGER                   'Flag field for BASIC procedure
  180.    Refed AS INTEGER                     'Flag field shows referenced proc.
  181. END TYPE
  182.  
  183.  
  184. '~~~~~ Declare routines
  185. DECLARE FUNCTION Blanks% (Strng$)
  186. DECLARE FUNCTION CheckSum% (Strg$)
  187. DECLARE FUNCTION Exist% (FileName$)
  188. DECLARE FUNCTION NoPath$ (FileName$)
  189. DECLARE FUNCTION NoXtn$ (FileName$)
  190. DECLARE FUNCTION Null% (Text$)
  191. DECLARE FUNCTION QPLen% (Text$)
  192. DECLARE FUNCTION UserInp$ (NoSemi, Prompt$, Default$)
  193. DECLARE FUNCTION Valid% (FileName$)
  194.  
  195. DECLARE SUB CheckName (FileName$)
  196. DECLARE SUB FatalErr (Message$)
  197. DECLARE SUB FindT (SEG Element AS ANY, TypeWidth, NumEls, Search$)
  198. DECLARE SUB GetParms (FileName$, NewLib$, LstFile$, InpLibs$, BASLib$)
  199. DECLARE SUB MakeObj (Subs, Procs() AS ProcInfo, LstFile$)
  200. DECLARE SUB QPrint0 (Text$, Clr)
  201. DECLARE SUB ReadSource (FileName$, Procs() AS ProcInfo, Subs)
  202. DECLARE SUB SortT (SEG Element AS ANY, NumEls, Dir, TypeWidth, Offset, FieldWidth)
  203. DECLARE SUB SrchPath (FileName$, Paths$, NotFound)
  204.  
  205.  
  206. '~~~~~ Dim Procedure information array
  207. DIM Procs(1 TO MaxProcs) AS ProcInfo
  208.  
  209. DIM SHARED ObjName$, RspName$, LibDir$
  210. ObjName$ = ENVIRON$("TMP") + "External.obj" 'Saved Object file
  211. RspName$ = ENVIRON$("TMP") + "DonMalin.rsp" 'Temporary response file for LINK
  212. LibDir$ = ENVIRON$("LIB") + "\"
  213. OtherObjName$ = ""
  214.  
  215. '~~~~~ Print Banner
  216. PRINT
  217. PRINT "Quick-Library Maker Utility  Version 1.03"
  218. PRINT "Copyright (c) 1988, 1989 Crescent Software"
  219. PRINT "FASTQLB has modifications by David A. Violette, CompuServe 76456,1602."
  220. PRINT "For personal use only; Crescent Software still owns the Copyright."
  221. PRINT "Modified version made available by permission from Crescent Software."
  222. PRINT
  223.  
  224.  
  225. '~~~~~ Get input parameters from COMMAND$ or by prompting the User
  226. GetParms FileName$, NewLib$, LstFile$, InpLibs$, BASLib$
  227.  
  228.  
  229.  
  230. Subs = 0                                        'Init. number of procs.
  231.  
  232.  
  233. '~~~~~ Read each Main Module or List file specified
  234. look = 1
  235. DO
  236.    Spac = INSTR(look, FileName$, " ")
  237.    IF Spac = 0 THEN Spac = QPLen%(FileName$) + 1
  238.    SourceName$ = LTRIM$(MID$(FileName$, look, Spac - look))
  239.    IF INSTR(SourceName$, ".") = 0 THEN SourceName$ = SourceName$ + ".BAS"
  240.  
  241.  
  242.    '~~~~~ Are we using a List file (.LST)?
  243.    SELECT CASE MID$(FileName$, INSTR(FileName$, ".") + 1)
  244.       CASE "LST"
  245.  
  246.          '~~~~~ Read the routine names into array (Procs)
  247.          CheckName FileName$
  248.          OPEN FileName$ FOR INPUT AS #1
  249.          Blank$ = SPACE$(ProcLen2)
  250.          DO UNTIL EOF(1)
  251.             Subs = Subs + 1
  252.             IF Subs > MaxProcs THEN FatalErr "Too many procedures!"
  253.             LINE INPUT #1, Procs(Subs).ProcName
  254.             IF Procs(Subs).ProcName = Blank$ THEN
  255.                Subs = Subs - 1
  256.             ELSE
  257.                Procs(Subs).ProcName = UCASE$(Procs(Subs).ProcName)
  258.             END IF
  259.          LOOP
  260.          CLOSE #1
  261.  
  262.       CASE "OBJ"
  263.          OtherObjName$ = OtherObjName$ + " " + FileName$
  264.  
  265.       CASE ELSE
  266.  
  267.          '~~~~~ Search source files for external references
  268.          ReadSource SourceName$, Procs(), Subs
  269.  
  270.    END SELECT
  271.  
  272.    look = Spac + 1
  273. LOOP UNTIL Spac = QPLen%(FileName$) + 1
  274.  
  275.  
  276.  
  277. '~~~~~ Bail out if no external routines found.
  278. IF Subs = 0 THEN FatalErr "No external routines required."
  279.  
  280.  
  281. '~~~~~ Sort the procedure names
  282. SortT Procs(1), Subs, 0, ProcLen2 * 2 + 4, 0, ProcLen2
  283.  
  284.  
  285. '~~~~~ Create the object and list files
  286. MakeObj Subs, Procs(), LstFile$
  287.  
  288.  
  289. '~~~~~ Display status message
  290. LOCATE , 1
  291. QPrint0 SPACE$(78), -1
  292. QPrint0 "Creating " + NewLib$, -1
  293.  
  294.  
  295. '~~~~~ SHELL out to LINK.EXE to build the new Quick Library.
  296. LINK$ = "LINK /q/noe/seg:512 " + ObjName$ + OtherObjName$ + "," + NewLib$ + ",nul," + InpLibs$ + " " + BASLib$ + "; > LinkErr$.Tmp"
  297.  
  298.  
  299.  
  300. IF QPLen%(LINK$) < 127 THEN             'Check length of command line
  301.    SHELL LINK$
  302. ELSE                                    'Line too long
  303.    '~~~~~ Create a LINK response file
  304.    OPEN RspName$ FOR OUTPUT AS #1
  305.    PRINT #1, "/q/noe/seg:512 " + ObjName$ + OtherObjName$ + ","
  306.    PRINT #1, NewLib$ + ",nul,"
  307.    PRINT #1, LibDir$ + InpLibs$ + "+"
  308.    PRINT #1, LibDir$ + BASLib$ + ";"
  309.    CLOSE #1
  310.  
  311.    SHELL "LINK @" + RspName$ + " > LinkErr$.Tmp"
  312.    KILL RspName$
  313. END IF
  314.  
  315. 'KILL ObjName$          No, save it for use in making .LIB (DAV)
  316. IF NOT Exist("LinkErr$.Tmp") THEN FatalErr "Cannot find [LINK.EXE]!"
  317.  
  318.  
  319. '~~~~~ Check for LIB.EXE errors (OBJects not found)
  320. LOCATE , 1
  321. LinkErr = 0
  322. OPEN "LinkErr$.Tmp" FOR INPUT AS #1     'Open LIB.EXE message file
  323. DO UNTIL EOF(1)
  324.    LINE INPUT #1, Text$                 'Read a line
  325.                                         'Was there an error?
  326.    IF INSTR(Text$, "error") OR INSTR(UCASE$(Text$), "MEMORY") THEN
  327.       BEEP                              'Yes, display the message
  328.       LinkErr = -1
  329.       LOCATE , 1
  330.       PRINT SPACE$(79)
  331.       PRINT Text$
  332.       DO UNTIL EOF(1)
  333.          LINE INPUT #1, Text$
  334.          PRINT Text$
  335.       LOOP
  336.    END IF
  337. LOOP                                    'Look for more
  338. CLOSE #1
  339. KILL "LinkErr$.Tmp"
  340.  
  341.  
  342. '~~~~~ Display status message
  343. IF NOT LinkErr THEN
  344.    QPrint0 SPACE$(78), -1
  345.    PRINT
  346.    PRINT NewLib$; " Created."
  347. END IF
  348.  
  349.  
  350.  
  351. '~~~~~ Data used by "MakeObj" to create Object file header and footer.
  352. DATA 128,14,0,12,99,104,114,105,115,109,97,121,46,65,83,77,247,150,39
  353. DATA 0,0,6,68,71,82,79,85,80,13,67,72,82,73,83,77,65,89,95,84,69,88,84
  354. DATA 4,68,65,84,65,4,67,79,68,69,5,95,68,65,84,65,160,152,7,0,72,0
  355. DATA 0,3,5,1,16,152,7,0,72,0,0,6,4,1,14,154,4,0,2,255,2,95
  356. DATA 136,4,0,0,162,1,209,138,2,0,0,116
  357.  
  358. '~~~~~ Check File Name for validity
  359. SUB CheckName (FileName$) STATIC
  360.  
  361.     IF NOT Valid%(FileName$) THEN
  362.        FatalErr "`" + FileName$ + "' is not a valid file name!"
  363.     END IF
  364.  
  365. END SUB
  366.  
  367. '~~~~~ Displays error message and ends the program
  368. SUB FatalErr (Message$) STATIC
  369.  
  370.     BEEP
  371.     PRINT
  372.     QPrint0 Message$ + "  Program terminated.", -1
  373.     PRINT
  374.     END
  375.  
  376. END SUB
  377.  
  378. '~~~~~ Get Input Parameters from User
  379. SUB GetParms (FileName$, NewLib$, LstFile$, InpLibs$, BASLib$) STATIC
  380.  
  381.     FileName$ = ".BAS"
  382.     InpLibs$ = "PRO7.LIB"
  383.     BASLib$ = BQLB$
  384.     NoSemi = 5
  385.  
  386.  
  387.     '~~~~~ Get command line parameters from COMMAND$
  388.     IF QPLen%(COMMAND$) THEN
  389.  
  390.        Param = 1
  391.        P = 1
  392.        CMD$ = COMMAND$
  393.  
  394.        '~~~~~ Check for a response file... allows use of "+" for continuation
  395.        '      of lines.
  396.        Rsp = INSTR(CMD$, "@")
  397.        IF Rsp THEN
  398.           L = LEN(CMD$)
  399.           Rsp$ = ""
  400.           I = Rsp + 1
  401.           DO WHILE MID$(CMD$, I, 1) <> " "
  402.             Rsp$ = Rsp$ + MID$(CMD$, I, 1)
  403.             IF I = L THEN EXIT DO ELSE I = I + 1
  404.           LOOP
  405.           ResFx = FREEFILE
  406.           OPEN "i", ResFx, Rsp$
  407.           CMD$ = ""
  408.           WHILE NOT EOF(ResFx)
  409.                LINE INPUT #ResFx, ICmd$
  410.                IF MID$(ICmd$, QPLen(ICmd$), 1) = "+" THEN MID$(ICmd$, QPLen(ICmd$), 1) = " "
  411.                CMD$ = CMD$ + ICmd$
  412.           WEND
  413.           ICmd$ = ""
  414.           CLOSE ResFx
  415.        END IF
  416.  
  417.        DO
  418.  
  419.            '~~~~~ Parse out parameter looking for [,] or [;] or EOL
  420.            PC = INSTR(P, CMD$, ",")
  421.            IF PC = 0 THEN PC = INSTR(P, CMD$, ";")
  422.            IF PC = 0 THEN PC = QPLen%(CMD$) + 1
  423.            Temp$ = UCASE$(LTRIM$(RTRIM$(MID$(CMD$, P, PC - P))))
  424.  
  425.            '~~~~~ Assign parameters
  426.            SELECT CASE Param
  427.               CASE 1                            'File Name
  428.                  FileName$ = Temp$
  429.                  IF FileName$ = "" THEN FatalErr "No Source File Name!"
  430.  
  431.                  BaseName$ = NoXtn$(FileName$)
  432.                  IF BaseName$ = FileName$ THEN FileName$ = FileName$ + ext$
  433.                  NoSemi = 4
  434.               CASE 2                            'New Quick Library name
  435.                  NewLib$ = Temp$
  436.                  NoSemi = 3
  437.               CASE 3                            'List file name
  438.                  LstFile$ = Temp$
  439.                  NoSemi = 2
  440.               CASE 4                            'Input Library names
  441.                  InpLibs$ = Temp$
  442.                  NoSemi = 1
  443.               CASE 5                            'BASIC library name
  444.                  BASLib$ = Temp$
  445.                  NoSemi = 0
  446.               CASE ELSE
  447.            END SELECT
  448.  
  449.            Param = Param + 1                    'Bump parameter number
  450.            P = PC + 1
  451.        LOOP UNTIL PC >= QPLen%(CMD$) OR MID$(CMD$, PC, 1) = ";"   'Get another
  452.  
  453.     END IF
  454.  
  455.  
  456.     '~~~~~ Prompt User for parameters
  457.     IF INSTR(COMMAND$, ";") = 0 THEN            'No semicolon, prompt User
  458.        IF NoSemi = 5 THEN GOSUB GetSource
  459.        IF NoSemi >= 4 THEN GOSUB GetNewLib
  460.        IF NoSemi >= 3 THEN GOSUB GetListFile
  461.        IF NoSemi >= 2 THEN GOSUB GetInputLibs
  462.        IF NoSemi >= 1 THEN GOSUB GetBQLBLib
  463.        PRINT
  464.     END IF
  465.  
  466.  
  467.     '~~~~~ Make default names for parameters if required
  468.     IF QPLen%(NewLib$) = 0 THEN NewLib$ = NoPath$(BaseName$) + ".QLB"
  469.     IF INSTR(NewLib$, ".") = 0 THEN NewLib$ = NewLib$ + ".QLB"
  470.     CheckName NewLib$
  471.  
  472.     IF QPLen%(LstFile$) = 0 THEN LstFile$ = NoPath$(BaseName$) + ".LST"
  473.     IF INSTR(LstFile$, ".") = 0 THEN LstFile$ = LstFile$ + ".LST"
  474.     CheckName LstFile$
  475.  
  476.     IF QPLen%(InpLibs$) = 0 THEN InpLibs$ = "PRO.LIB"
  477.  
  478.     IF QPLen%(BASLib$) = 0 THEN BASLib$ = BQLB$
  479.     IF INSTR(BASLib$, ".") = 0 THEN BASLib$ = BASLib$ + ".LIB"
  480.     CheckName BASLib$
  481.  
  482.  
  483.     '~~~~~ Search for required libraries using "LIB" environment variables
  484.     LibPaths$ = ENVIRON$("LIB")
  485.  
  486.     P = 1
  487.     DO                                          'Parse out individual names
  488.         PC = INSTR(P, InpLibs$, " ")
  489.         IF PC = 0 THEN PC = QPLen%(InpLibs$) + 1
  490.         InpLib$ = LTRIM$(RTRIM$(MID$(InpLibs$, P, PC - P)))
  491.  
  492.         IF INSTR(InpLib$, ".") = 0 THEN InpLib$ = InpLib$ + ".LIB"
  493.         CheckName InpLib$
  494.  
  495.         SrchPath InpLib$, LibPaths$, NotFound   'Check path for file
  496.         IF NotFound THEN FatalErr InpLib$ + " not found!"
  497.  
  498.         P = PC + Blanks(MID$(InpLibs$, PC))
  499.     LOOP UNTIL P > LEN(InpLibs$)
  500.  
  501.  
  502.     SrchPath BASLib$, LibPaths$, NotFound       'Check paths for BASIC library
  503.     IF NotFound THEN FatalErr BASLib$ + " not found!"
  504.  
  505.     EXIT SUB
  506.  
  507.  
  508. '~~~~~ Get Source file name
  509. GetSource:
  510.     FileName$ = UserInp$(NoSemi, "Main Module Name", FileName$)
  511.  
  512.     IF FileName$ = ".BAS" THEN END           'Check validity
  513.     BaseName$ = NoXtn$(FileName$)
  514.     IF BaseName$ = FileName$ THEN FileName$ = FileName$ + ext$
  515. RETURN
  516.  
  517.  
  518. '~~~~~ Get output library name
  519. GetNewLib:
  520.     IF QPLen%(NewLib$) THEN
  521.        Default$ = NewLib$
  522.     ELSE
  523.        Default$ = NoPath$(BaseName$) + ".QLB"
  524.     END IF
  525.  
  526.     NewLib$ = UserInp$(NoSemi, "Output Library Name", Default$)
  527. RETURN
  528.  
  529.  
  530. '~~~~~ Get list file name
  531. GetListFile:
  532.     IF QPLen%(LstFile$) THEN
  533.        Default$ = LstFile$
  534.     ELSE
  535.        Default$ = NoPath$(BaseName$) + ".LST"
  536.     END IF
  537.  
  538.     LstFile$ = UserInp$(NoSemi, "List File Name", Default$)
  539. RETURN
  540.  
  541.  
  542. '~~~~~ Get input library names
  543. GetInputLibs:
  544.     InpLibs$ = UserInp$(NoSemi, "Input Libraries", InpLibs$)
  545. RETURN
  546.  
  547.  
  548. '~~~~~ Get BASIC library [BQLB] name
  549. GetBQLBLib:
  550.     BASLib$ = UserInp$(NoSemi, "BQLB## Library Name", BASLib$)
  551. RETURN
  552.  
  553.  
  554. END SUB
  555.  
  556. '~~~~~ Create an Object file consisting of EXTRN declarations
  557. '~~~~~ Also writes the List File
  558. SUB MakeObj (Subs, Procs() AS ProcInfo, LstFile$) STATIC
  559.  
  560.     LOCATE , 1
  561.     QPrint0 "Creating temporary file: `External.obj'.", -1
  562.  
  563.  
  564.     '~~~~~ Create files
  565.     IF Exist%(ObjName$) THEN KILL ObjName$
  566.     OPEN ObjName$ FOR BINARY AS #1
  567.     OPEN LstFile$ FOR OUTPUT AS #2
  568.  
  569.  
  570.     '~~~~~ Compose OBJ Header string
  571.     a$ = SPACE$(86)
  572.     FOR I = 1 TO 86
  573.         READ B
  574.         MID$(a$, I) = CHR$(B)
  575.     NEXT
  576.     PUT #1, , a$
  577.  
  578.  
  579.     '~~~~~ Compose external procedure names into OBJ form
  580.     I = 1                                       'initial value
  581.     DO
  582.         Count = 0
  583.         FileList$ = ""
  584.  
  585.         FOR N = I TO Subs                       'For each procedure name
  586.  
  587.             IF Procs(N).BasFlag = 0 THEN        'If it's an external proc.
  588.                                                 'print name to list file
  589.                IF NOT Null%(Procs(N).AliasName) THEN
  590.                   Temp$ = RTRIM$(Procs(N).AliasName)
  591.                ELSE
  592.                   Temp$ = RTRIM$(Procs(N).ProcName)
  593.                END IF
  594.  
  595.                PRINT #2, Temp$
  596.  
  597.                L = QPLen%(Temp$)
  598.                Count = Count + L + 2
  599.                IF Count > 1018 THEN EXIT FOR
  600.                FileList$ = FileList$ + CHR$(L) + Temp$ + CHR$(0)
  601.             ELSE
  602.  
  603.             END IF
  604.  
  605.         NEXT
  606.  
  607.         Lng = QPLen%(FileList$) + 1
  608.         FileList$ = CHR$(140) + CHR$(Lng MOD 256) + CHR$(Lng \ 256) + FileList$
  609.         FileList$ = FileList$ + CHR$(CheckSum(FileList$))
  610.         PUT #1, , FileList$
  611.         I = N
  612.  
  613.     LOOP WHILE I <= Subs
  614.  
  615.  
  616.     '~~~~~ Compose OBJ Footer
  617.     a$ = SPACE$(12)
  618.     FOR I = 1 TO 12
  619.        READ B
  620.        MID$(a$, I) = CHR$(B)
  621.     NEXT
  622.     PUT #1, , a$
  623.  
  624.  
  625.     CLOSE #1, #2
  626.  
  627. END SUB
  628.  
  629. FUNCTION NoPath$ (FileName$) STATIC
  630.  
  631.     Test$ = ":\"
  632.     FOR N = QPLen(FileName$) TO 1 STEP -1
  633.         IF INSTR(Test$, MID$(FileName$, N, 1)) THEN EXIT FOR
  634.     NEXT
  635.  
  636.     NoPath$ = MID$(FileName$, N + 1)
  637.  
  638. END FUNCTION
  639.  
  640. '~~~~~ Returns the base part of a file name
  641. FUNCTION NoXtn$ (FileName$) STATIC
  642.  
  643.     Per = INSTR(FileName$, ".")
  644.     Spac = INSTR(FileName$, " ")
  645.     IF Spac = 0 THEN Spac = QPLen%(FileName$) + 1
  646.  
  647.     IF Per > 0 AND Per < Spac THEN
  648.        NoXtn$ = LEFT$(FileName$, Per - 1)
  649.     ELSE
  650.        NoXtn$ = LEFT$(FileName$, Spac - 1)
  651.     END IF
  652.  
  653. END FUNCTION
  654.  
  655. '~~~~~ Read Source files looking for external routines and dead code
  656. SUB ReadSource (FileName$, Procs() AS ProcInfo, Subs) STATIC
  657.  
  658.     RtnTerm$ = " -)(%!#&@$:" + CHR$(9)   'Terminators for SUB/FUNCTION names
  659.     FastLoadSave$ = CHR$(252) + CHR$(19)
  660.  
  661.     REDIM KWord$(3)                      'Keyword table for finding procedures
  662.     KWord$(0) = "FUNCTION "
  663.     KWord$(1) = "SUB "
  664.     KWord$(2) = "CALL "
  665.     KWord$(3) = "CALLS "
  666.  
  667.  
  668.     CheckName FileName$
  669.  
  670.     '~~~~~ Parse out file's path name
  671.     Path$ = LEFT$(FileName$, INSTR(FileName$, NoPath$(FileName$)) - 1)
  672.  
  673.  
  674.     '~~~~~ Load up the .MAK file if there is one.
  675.     MakeName$ = NoXtn$(FileName$) + ".MAK"
  676.  
  677.     IF Exist%(MakeName$) THEN
  678.        OPEN MakeName$ FOR INPUT AS #1
  679.  
  680.        Modules = 0                              'Count the number of modules
  681.        DO UNTIL EOF(1)
  682.           LINE INPUT #1, Text$
  683.           IF QPLen%(LTRIM$(Text$)) THEN Modules = Modules + 1
  684.        LOOP
  685.        CLOSE #1
  686.  
  687.        REDIM Make$(Modules)                     'Make array for module names
  688.        OPEN MakeName$ FOR INPUT AS #1
  689.  
  690.        FOR M = 1 TO Modules                     'Read the module names
  691.           LINE INPUT #1, Make$(M)
  692.           IF QPLen%(Make$(M)) THEN
  693.                                                 'Add a path name if needed
  694.              IF INSTR(Make$(M), "\") = 0 AND INSTR(Make$(M), ":") = 0 THEN
  695.                 Make$(M) = Path$ + Make$(M)
  696.              END IF
  697.              IF INSTR(Make$(M), ".") = 0 THEN Make$(M) = Make$(M) + ".BAS"
  698.              IF NOT Exist%(Make$(M)) THEN FatalErr Make$(M) + " not found!"
  699.           ELSE
  700.              M = M - 1
  701.           END IF
  702.        NEXT
  703.  
  704.        CLOSE #1
  705.  
  706.     ELSE                                        'One module
  707.  
  708.        Modules = 1
  709.        REDIM Make$(1)
  710.        Make$(1) = FileName$
  711.  
  712.     END IF
  713.                                                 'See if we have enough memory
  714.     IF FRE(-1) < ((MaxProcs + 1) * Modules * CLNG(ProcLen + 2)) + 1028& THEN
  715.        FatalErr "Not enough memory (too many modules)!"
  716.     END IF
  717.                                                 'Array for module level procs.
  718.     REDIM ModSub(MaxProcs, 1 TO Modules) AS ModProcs
  719.     Rtn$ = SPACE$(ProcLen2)                     'Work space for proc. names
  720.  
  721.  
  722.  
  723.     '~~~~~ Search All Files for Procedure Names
  724.     LOCATE , 1
  725.     QPrint0 "Examining ", -1
  726.     LOCATE , 11
  727.  
  728.  
  729.     FOR M = 1 TO Modules                        'Examine each module
  730.         Handle = 1                              'File handle for module
  731.  
  732.         IF NOT Exist%(Make$(M)) THEN FatalErr "Cannot find " + Make$(M) + "!"
  733.  
  734.         OPEN Make$(M) FOR INPUT AS #Handle      'Open the module
  735.  
  736.         QPrint0 SPACE$(68), -1
  737.         QPrint0 Make$(M), -1
  738.  
  739.  
  740.         '~~~~~ Read until end of module
  741.         DO UNTIL Handle = 1 AND EOF(1)
  742.  
  743.            DO WHILE EOF(Handle)                 'Close include file when done
  744.               CLOSE #Handle
  745.               Handle = Handle - 1
  746.               IF Handle = 1 THEN                'Redisplay module name
  747.                  QPrint0 SPACE$(68), -1
  748.                  QPrint0 Make$(M), -1
  749.                  EXIT DO
  750.               END IF
  751.            LOOP
  752.            IF Handle = 1 AND EOF(1) THEN EXIT DO
  753.  
  754.            Ky$ = INKEY$                         'Check for Ctrl C
  755.            IF QPLen%(Ky$) THEN
  756.               IF ASC(Ky$) = 3 THEN FatalErr ""
  757.            END IF
  758.  
  759.  
  760.            LINE INPUT #Handle, Text$            'Read a line of text
  761.            Text$ = UCASE$(Text$)                'Make it upper case
  762.  
  763.                                                 'Test for binary file (Fast
  764.                                                 '  Load and Save)
  765.            IF INSTR(Text$, FastLoadSave$) THEN
  766.               FatalErr "Cannot process QuickBASIC - Fast Load and Save files!"
  767.            END IF
  768.  
  769.  
  770.  
  771.            Length = INSTR(Text$, "'") - 1       'Get Length without comments
  772.            IF Length = -1 THEN Length = INSTR(Text$, "REM ") - 1
  773.            IF Length = -1 THEN Length = QPLen%(Text$)
  774.  
  775.  
  776.  
  777.            '~~~~~ Look for INCLUDE files
  778.            Inc = INSTR(Text$, "$INCLUDE:")
  779.  
  780.            IF Inc THEN
  781.  
  782.               IF INSTR(Length + 2, Text$, "'") > Inc THEN
  783.                  Inc = INSTR(Inc, Text$, "'") + 1
  784.                  Inc2 = INSTR(Inc, Text$, "'")
  785.                  IF Inc2 > Inc THEN
  786.                     IncName$ = MID$(Text$, Inc, Inc2 - Inc)
  787.                     IF INSTR(IncName$, ".") = 0 THEN IncName$ = IncName$ + ".BAS"
  788.                                                 'Add path to include name
  789.                     IF QPLen%(Path$) AND INSTR(IncName$, "\") = 0 AND INSTR(IncName$, ":") = 0 THEN
  790.                        IncName$ = Path$ + IncName$
  791.                     END IF
  792.  
  793.                     IF NOT Exist%(IncName$) THEN
  794.                        IncName$ = MID$(IncName$, QPLen%(Path$) + 1)
  795.                                                 'Check envirnment path
  796.                        SrchPath IncName$, ENVIRON$("INCLUDE"), NotFound
  797.                        IF NotFound THEN FatalErr "Include file " + IncName$ + " not found!"
  798.                     END IF
  799.  
  800.                     Handle = Handle + 1         'Bump handle
  801.                     OPEN IncName$ FOR INPUT AS #Handle 'Open the include file
  802.  
  803.                     QPrint0 SPACE$(68), -1      'Display the name of INCLUDE
  804.                     QPrint0 "Include File: " + IncName$, -1
  805.  
  806.                     Length = 0
  807.                  END IF
  808.  
  809.               END IF
  810.            END IF
  811.            
  812.  
  813.                                                 'Trim left side and remark
  814.            Text$ = LTRIM$(LEFT$(Text$, Length))
  815.  
  816.  
  817.            IF QPLen(Text$) THEN                 'If its not a Nul string,
  818.  
  819.               N = INSTR(Text$, CHR$(34))        'Remove quoted strings
  820.               IF N THEN
  821.                  IF INSTR(Text$, "ALIAS") = 0 THEN 'Except Alias name
  822.                     Text$ = LEFT$(Text$, N - 1) + MID$(Text$, INSTR(N + 1, Text$, CHR$(34)) + 1)
  823.                  END IF
  824.               END IF
  825.  
  826.  
  827.               '~~~~~ Check for each key word
  828.               FOR KW = 0 TO 3
  829.                   KWPos = 1
  830.  
  831.                   DO
  832.                                                 'Look for key word
  833.                      KWPos = INSTR(KWPos, Text$, KWord$(KW))
  834.  
  835.                      IF KWPos > 1 THEN          'Make sure it's a whole word
  836.                         IF INSTR(CHR$(32) + CHR$(9), MID$(Text$, KWPos - 1, 1)) = 0 THEN KWPos = 0
  837.  
  838.                         'IF KW < 2 THEN          'Check for valid declare
  839.                         '   IF INSTR(Text$, "DECLARE") <> KWPos - 8 THEN KWPos = 0
  840.                         'END IF
  841.                      END IF
  842.  
  843.  
  844.                      IF KWPos THEN              'If there's a valid key word
  845.  
  846.                         '~~~~~ Extract the keyword from the line
  847.                                                 'Bump pointer to end of key
  848.                         KWEnd = KWPos + QPLen%(KWord$(KW))
  849.                                                 'look for end of proc. name
  850.                         FOR P2 = KWEnd + 1 TO QPLen%(Text$)
  851.                             IF INSTR(RtnTerm$, MID$(Text$, P2, 1)) THEN EXIT FOR
  852.                         NEXT
  853.                                                 'Extract proceedure name
  854.                         LSET Rtn$ = MID$(Text$, KWEnd, P2 - KWEnd)
  855.  
  856.  
  857.                         '~~~~~ See if procedure used before in ANY modules
  858.                         N = Subs
  859.                         FindT Procs(1), ProcLen2 * 2 + 4, N, Rtn$
  860.                         IF N = -1 THEN
  861.                            N = Subs + 1
  862.                            IF N > MaxProcs THEN FatalErr "Too many procedures!"
  863.                         ELSE
  864.                            N = N + 1
  865.                         END IF
  866.  
  867.  
  868.                         '~~~~~ See if procedure used before in THIS module
  869.                         MS = ModSub(0, M).Count
  870.                         ModSub(0, M).ProcName = Rtn$
  871.                         FindT ModSub(1, M), ProcLen + 2, MS, ModSub(0, M).ProcName
  872.                         IF MS = -1 THEN
  873.                            MS = ModSub(0, M).Count + 1
  874.                            ModSub(0, M).Count = MS 'Bump number of procedures
  875.                            ModSub(MS, M).ProcName = Rtn$ 'Assign Proc. name
  876.                         ELSE
  877.                            MS = MS + 1
  878.                         END IF
  879.  
  880.  
  881.                         '~~~~~ If it's a "CALL" or "CALLS",
  882.                         IF KW > 1 THEN          'Bump count for routine
  883.                            ModSub(MS, M).Count = ModSub(MS, M).Count + 1
  884.                            Procs(N).Refed = 2
  885.                         END IF
  886.  
  887.  
  888.                         '~~~~~ Is this a BASIC proc. definition (SUB/FUNCTION)?
  889.                         IF KW < 2 THEN 'AND KWPos = 1 THEN
  890.                            IF INSTR(Text$, "DECLARE") <> KWPos - 8 THEN
  891.                               Procs(N).BasFlag = BASProc 'Set flag
  892.                                                 'If referenced befor, set flag
  893.                               IF Procs(N).Refed > 1 OR ModSub(MS, M).Count THEN
  894.                                  Procs(N).BasFlag = RefedProc
  895.                               END IF
  896.                            END IF
  897.                         END IF
  898.  
  899.  
  900.                         '~~~~~ If its a new procedure name
  901.                         IF N > Subs THEN
  902.                            Procs(N).ProcName = Rtn$ 'Assign it
  903.                            Subs = N             'Bump number of procedures
  904.                                                 'Look for an ALIAS name
  905.                            Al = INSTR(Text$, "ALIAS")
  906.                            IF Al THEN
  907.                               Al = Al + 7
  908.                               AlEnd = INSTR(Al, Text$, CHR$(34))
  909.                               Procs(N).AliasName = MID$(Text$, Al, AlEnd - Al)
  910.                            END IF
  911.                                                 'Is this a BASIC procedure?
  912.                         ELSEIF Procs(N).BasFlag = BASProc THEN
  913.                            IF Procs(N).Refed > 1 OR ModSub(MS, M).Count THEN
  914.                                                 'Set flag to show it was
  915.                               Procs(N).BasFlag = RefedProc '  referenced
  916.                            END IF
  917.                         END IF
  918.  
  919.                                                 'Remove Name so it isn't
  920.                                                 '  found below
  921.                         Text$ = LEFT$(Text$, KWEnd - 1) + MID$(Text$, P2)
  922.  
  923.                         KWPos = KWPos + 1       'Bump pointer for next word
  924.  
  925.                      END IF
  926.  
  927.                   LOOP WHILE KWPos AND KW > 1   'Look for more on line
  928.  
  929.               NEXT                              'Check for next key word
  930.  
  931.  
  932.               '~~~~~ Look for references to procs. that were declared
  933.               FOR N = 1 TO ModSub(0, M).Count   'Examin text for prev. refs.
  934.  
  935.                   IF ModSub(N, M).Count = 0 THEN
  936.  
  937.                      look = 0
  938.                      DO
  939.                         look = INSTR(look + 1, Text$, RTRIM$(ModSub(N, M).ProcName))
  940.  
  941.                         IF look THEN
  942.                            Start = look
  943.                            IF Start > 1 THEN       'Begining of line?
  944.                                                    'Check Begining of word
  945.                               IF INSTR(RtnTerm$, MID$(Text$, Start - 1, 1)) = 0 THEN
  946.                                  Start = 0
  947.                               END IF
  948.                            END IF
  949.                     
  950.                            IF Start THEN           'Check end of word
  951.                               PrLen = QPLen%(RTRIM$(ModSub(N, M).ProcName))
  952.                               IF INSTR(RtnTerm$, MID$(Text$, Start + PrLen, 1)) THEN
  953.                                  ModSub(N, M).Count = ModSub(N, M).Count + 1
  954.                                                    'Check for previous refs.
  955.                                  LSET Rtn$ = MID$(Text$, Start, PrLen)
  956.                                  P = Subs
  957.                                  FindT Procs(1), ProcLen2 * 2 + 4, P, Rtn$
  958.                                  IF P > -1 THEN
  959.                                     P = P + 1
  960.                                                    'Is it a BASIC procedure?
  961.                                     IF Procs(P).BasFlag THEN
  962.                                        '~~~~~ Check for function assignment
  963.                                        IF MID$(Text$, Start + PrLen + 1, 1) = "=" THEN
  964.                                                    'Decrement counter
  965.                                           ModSub(N, M).Count = ModSub(N, M).Count - 1
  966.                                        ELSE        'Show it was referenced
  967.                                           Procs(P).Refed = 2
  968.                                        END IF
  969.                                     ELSE           'Show it was referenced
  970.                                        Procs(P).Refed = 2
  971.                                     END IF
  972.                                  END IF
  973.                               END IF
  974.                            END IF
  975.                         END IF
  976.  
  977.                      LOOP WHILE look
  978.  
  979.                   END IF
  980.               NEXT
  981.  
  982.            END IF
  983.  
  984.         LOOP                                    'Read another line of text
  985.  
  986.         CLOSE #1                                'Close the module
  987.  
  988.     NEXT                                        'Read the next module file
  989.  
  990.     ERASE KWord$                                'Clean up string space
  991.     Text$ = ""
  992.  
  993.     LOCATE , 1
  994.     QPrint0 SPACE$(78), -1                      'Erase message from screen
  995.  
  996.  
  997.     '~~~~~ Display unreferenced routines
  998.     NoTitle = -1
  999.     FOR M = 1 TO Modules                        'For each module
  1000.  
  1001.         R = FREEFILE                            'DAV added this feature so
  1002.         UMake$ = LEFT$(Make$(M), LEN(Make$(M)) - 4) + ".UNR"  'unreferenced
  1003.         OPEN UMake$ FOR OUTPUT AS #R            'items will be saved
  1004.  
  1005.         NoModName = -1
  1006.         FOR N = 1 TO ModSub(0, M).Count         'For each procedure in module
  1007.             IF ModSub(N, M).Count = 0 THEN      'Count of 0 means wasn't used
  1008.                                                 'Look in master list
  1009.                P = Subs
  1010.                FindT Procs(1), ProcLen2 * 2 + 4, P, ModSub(N, M).ProcName
  1011.                P = P + 1
  1012.                                                 'Confirm lack of reference
  1013.                IF Procs(P).BasFlag <> RefedProc AND Procs(P).Refed <> 2 THEN
  1014.  
  1015.                   IF NoTitle THEN               'Print error message
  1016.                      PRINT
  1017.                      Msg$ = "Note: The following procedures have been declared or defined but never used."
  1018.                      PRINT Msg$: PRINT #R, Msg$
  1019.                      NoTitle = 0
  1020.                   END IF
  1021.                   IF NoModName THEN             'Print Module name
  1022.                      Msg$ = Make$(M)
  1023.                      PRINT Msg$: PRINT #R, Msg$
  1024.                      NoModName = 0
  1025.                   END IF
  1026.                                                 'Print procedure name
  1027.                   PRINT TAB(4); ModSub(N, M).ProcName;
  1028.                   PRINT #R, TAB(4); ModSub(N, M).ProcName;
  1029.                   IF Procs(P).BasFlag = BASProc THEN 'Print message
  1030.                      Msg$ = " is an unused BASIC procedure."
  1031.                      PRINT Msg$: PRINT #R, Msg$
  1032.                      
  1033.                   ELSE
  1034.                      Msg$ = " was DECLAREd but not used"
  1035.                      PRINT Msg$; : PRINT #R, Msg$;
  1036.                      IF Procs(P).Refed <> 2 THEN
  1037.                         Msg$ = "."
  1038.                         PRINT Msg$: PRINT #R, Msg$
  1039.                         Procs(P).BasFlag = 1
  1040.                      ELSE
  1041.                         Msg$ = " in this module."
  1042.                         PRINT Msg$: PRINT #R, Msg$
  1043.                         Procs(P).BasFlag = 0
  1044.                      END IF
  1045.                   END IF
  1046.                END IF
  1047.             END IF
  1048.         NEXT
  1049.     CLOSE #R
  1050.     NEXT
  1051.  
  1052.     ERASE ModSub, Make$
  1053.     Rtn$ = "": Msg$ = "": UMake$ = ""
  1054.  
  1055. END SUB
  1056.  
  1057. '~~~~~ Search an environment path for a file
  1058. SUB SrchPath (FileName$, Paths$, NotFound) STATIC
  1059.  
  1060.     NotFound = -1                               'Guilty until proven otherwise
  1061.     Path$ = ""                                  'No Path yet
  1062.     PP = 1                                      'Present position
  1063.  
  1064.     DO UNTIL Exist(Path$ + FileName$)           'Loop until we find the file
  1065.        IF PP > QPLen%(Paths$) THEN EXIT SUB     'Bail out if no more paths
  1066.  
  1067.        PCP = INSTR(PP, Paths$, ";")             'Find Semicolon position
  1068.        IF PCP = 0 THEN PCP = QPLen%(Paths$) + 1 'Last path
  1069.                                                 'Parse out the path
  1070.        Path$ = LTRIM$(RTRIM$(MID$(Paths$, PP, PCP - PP)))
  1071.                                                 'Ensure there's a "\" at end
  1072.        IF RIGHT$(Path$, 1) <> "\" THEN Path$ = Path$ + "\"
  1073.                                                 'Bump position for next path
  1074.        PP = PCP + 1
  1075.     LOOP
  1076.  
  1077.     FileName$ = Path$ + FileName$               'Add the path to the file name
  1078.     NotFound = 0
  1079.  
  1080. END SUB
  1081.  
  1082. '~~~~~ Prompt User for input
  1083. FUNCTION UserInp$ (NoSemi, Prompt$, Default$) STATIC
  1084.  
  1085.     PRINT Prompt$; " ["; Default$; "]: ";
  1086.     LINE INPUT ""; Temp$
  1087.     
  1088.     Temp$ = UCASE$(LTRIM$(RTRIM$(Temp$)))
  1089.     IF RIGHT$(Temp$, 1) = ";" THEN
  1090.        Temp$ = LEFT$(Temp$, QPLen(Temp$) - 1)
  1091.        NoSemi = 0
  1092.     END IF
  1093.     IF QPLen%(Temp$) = 0 THEN Temp$ = Default$
  1094.     
  1095.     UserInp$ = Temp$
  1096.  
  1097. END FUNCTION
  1098.  
  1099.